home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / PBHIGH.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  5KB  |  172 lines
  1. {SECTION ..PbHIGH }
  2. UNIT PbHIGH;
  3. {$V-}
  4.  
  5. INTERFACE
  6.  
  7. USES DOS, PbMISC, PbDATA, PbOBJS;
  8.  
  9. {-}
  10. {
  11. Description : HNR higher level routines using MISC and OBJS
  12.  
  13. Author      : Howard Richoux
  14. Date        : 2/18/94
  15. Last revised: 2/18/94 old filescan routines
  16.  
  17.  
  18. Application : IBM PC and compatibles, done in Turbo Pascal 7
  19. Status      : Placed in the Public Domain by HNR Software 1/29/1994
  20. Published in: none
  21. }
  22.  
  23. type  TFILE_ProcessLineProc = procedure( s : string );
  24.  
  25.  
  26. Procedure CreateTEXTSectionIndex(fn, sectiontag : string;
  27.                                  var sections : HOLD_object);
  28.             {[FILE] Creates section index for reading sectioned files}
  29.  
  30. Procedure GetfilesSTRA( Template : string; var files : STRA_object;
  31.                     fsortcode : integer);
  32.              {[FILE] Returns a work list of files from one directory.}
  33.  
  34. Procedure ReadTEXTfile(fn : string; work : TFILE_ProcessLineProc);
  35.             {[FILE] All-in-one text file reader}
  36.  
  37. Procedure ReadTEXTSection(fn, sectiontag, sectionname : string;
  38.                           startpos : longint; work : TFILE_ProcessLineProc);
  39.             {[FILE] All-in-one text file SECTION reader}
  40.  
  41.  
  42. {SECTION  .ZImplementation }
  43. IMPLEMENTATION
  44.  
  45.  
  46. {SECTION  CreateTEXTSectionIndex  }
  47. Procedure CreateTEXTSectionIndex(fn, sectiontag : string;
  48.                                  var sections : HOLD_object);
  49. var secttag,sectname  : string[40];
  50.     sectlen   : integer;
  51.     ok, found : boolean;
  52.     l         : longint;
  53.     s         : string;
  54.     tx        : TFILE_object;
  55.      begin
  56.      found := false;
  57.      secttag  := UpCaseStr(sectiontag);
  58.      sectname := '';
  59.      tx.init(fn,false);
  60.      ok := tx.opened;
  61.      l := 0;
  62.      while ok do
  63.           begin
  64.           ok := tx.fetchnext(s);
  65.           if ok then
  66.                begin
  67.              {  writeln('<',s,'>'); }
  68.                if secttag = leftstr(UpCaseStr(s),length(secttag)) then
  69.                      begin
  70.                      delete(s,1,length(secttag));
  71.                      RemoveLeading(s,' ');
  72.                      s := UpCaseStr(s);
  73.                      sectname := GetLeftstr(s,' ');
  74.                      ok := sections.append(sectname,l);
  75.                     { writeln('[',sectname,',',l,']');}
  76.                      end;
  77.                l := tx.currentposition;
  78.                end;
  79.           end;
  80.      tx.done;
  81.      end;
  82.  
  83.  
  84. {SECTION  GetFilesSTRA }
  85. Procedure GetfilesSTRA( Template : string; var files : STRA_object;
  86.                     fSortcode : integer);
  87. var SR : searchrec;
  88.     ok : boolean;
  89.      begin
  90.      FindFirst(Template,AnyFile,SR);
  91.      while DOSError = 0 do
  92.           begin
  93.           if length(sr.name) > 4 then
  94.               begin
  95.               ok := files.append(sr.name);
  96.               end;
  97.           FindNext(SR);
  98.           end;
  99.  
  100.      if fSortcode = fSortbyName then files.sort;
  101.      end;
  102.  
  103.  
  104. {SECTION  ReadTEXTfile  }
  105. Procedure ReadTEXTfile(fn : string; work : TFILE_ProcessLineProc);
  106. var tx : TFILE_object;
  107.     s  : string;
  108.      begin
  109.      tx.init(fn,false);
  110.      while tx.fetchnext(s) do work(s);
  111.      tx.done;
  112.      end;
  113.  
  114.  
  115.  
  116. {SECTION  ReadTEXTSection  }
  117. Procedure ReadTEXTSection(fn, sectiontag, sectionname : string;
  118.                           startpos : longint; work : TFILE_ProcessLineProc);
  119. var secttag,sectname  : string[40];
  120.     sectlen   : integer;
  121.     ok, found : boolean;
  122.     s,s0      : string;
  123.     tx        : TFILE_object;
  124.      begin
  125.      found := false;
  126.      secttag  := UpCaseStr(sectiontag);
  127.      sectname := UpCaseStr(sectionname);
  128.      trim(sectname);
  129.      sectlen  := length(sectname);
  130.      tx.init(fn,false);
  131.      ok := tx.opened;
  132.      if ok and (startpos > 0) then tx.seek(startpos);
  133.      if sectionname = '' then  {name of '' means until first secttag }
  134.           begin
  135.           found := true;
  136.           end;
  137.      while ok do
  138.           begin
  139.           ok := tx.fetchnext(s0);
  140.           s := s0;
  141.           if ok then
  142.                begin
  143.               { if not found then writeln('*<',s,'>');}
  144.                if secttag = leftstr(UpCaseStr(s),length(secttag)) then
  145.                      begin
  146.                      if found then
  147.                           begin
  148.                           found := false;
  149.                           ok := false;
  150.                           end
  151.                      else begin
  152.                           delete(s,1,length(secttag));
  153.                           RemoveLeading(s,' ');
  154.                           if leftstr(UpCaseStr(s),sectlen) = sectname then
  155.                                begin
  156.                                found := true;
  157.                                WORK(s0);   { return the section statement also}
  158.                                end;
  159.                           end;
  160.                      end
  161.                else if found then WORK(s0);
  162.                end;
  163.           end;
  164.      tx.done;
  165.      end;
  166.  
  167.  
  168.  
  169. {SECTION ZInitialization }
  170.      begin  { initializaion }
  171.      end.
  172.